home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS03.ADF / ABasiCprogs / Cards.bas < prev    next >
BASIC Source File  |  1986-04-02  |  10KB  |  287 lines
  1. 0     rem ******  CARDS  ******
  2. 5     t=0
  3. 10    dv=570:dim card%(dv),sm%(18),sms%(4,18),lg%(23),lgs%(4,22)
  4. 45    peno 15
  5. 46    outline 1
  6. 47    drawmode 0
  7. 50    pena 2:box(50,50;110,120),1
  8. 51    pena 0:draw(50,50):draw(110,50):draw(50,120):draw(110,120)
  9. 53    sshape(50,50;111,121),card%
  10. 55    for x= 0 to 1:read pat%(x):next
  11. 60    pattern 2, pat%()
  12. 70    data &b1111000011110000,&b0000111100001111
  13. 75    gshape(100,100),card%
  14. 76    pena 4:box(105,105;155,165)
  15. 77    peno 1:circle(130,135),22,.5:circle(130,135),15,1.5:rem draw(116,126 to 144,145)
  16. 78    pena 1:penb 4:paint(110,110),1
  17. 80    dim card53%(570)
  18. 85    sshape(100,100;161,171),card53%
  19. 90    pattern 0,off%
  20. 91    drawmode 1
  21. 105   rgb 0,15,15,15
  22. 106   outline 0
  23. 107   scnclr
  24. 110   pena 2:draw(50,50):pena 4
  25. 115   gosub 900
  26. 120   rem draw small heart
  27. 121   draw(52,50 to 53,50):draw(55,50 to 56,50)
  28. 122   draw(51,51 to 57,51)
  29. 123   draw(51,52 to 57,52)
  30. 124   draw(51,53 to 57,53)
  31. 125   draw(52,54 to 56,54)
  32. 126   draw(53,55 to 55,55)
  33. 127   draw(54,56)
  34. 129   sshape(50,50;58,57),sm%
  35. 130   for x=0 to 18:sms%(1,x)=sm%(x):next
  36. 131   gosub 900
  37. 132   draw(52,50 to 53,50):draw(57,50 to 58,50)
  38. 133   draw(to 59,51 to 60,52 to 60,54 to 55,59)
  39. 134   draw(to 50,54 to 50,52 to 51,51 to 52,50 to 53,50 to 54,51 )
  40. 135   draw(to 55,52 to 56,51 to 57,50)
  41. 136   paint (55,55),1
  42. 138   sshape (50,50;61,60),lg%
  43. 140   for x= 0 to 22:lgs%(1,x)=lg%(x):next
  44. 200   rem draw clubs
  45. 210   gosub 900:pena 1
  46. 220   draw(53,50 to 54,50)
  47. 221   draw(53,51 to 54,51)
  48. 222   draw(51,52 to 52,52)
  49. 223   draw(55,52 to 56,52)
  50. 224   draw(51,53 to 52,53)
  51. 225   draw(55,53 to 56,53)
  52. 226   draw(53,54 to 54,54)
  53. 227   draw(53,55 to 54,55)
  54. 228   draw(52,56 to 55,56)
  55. 230   sshape (50,50;57,57),sm%
  56. 235   for x=0 to 18:sms%(2,x)=sm%(x):next
  57. 240   gosub 900:pena 1
  58. 241   draw (55,50 to 55,59)
  59. 242   draw(50,54 to 60,54)
  60. 243   draw(53,59 to 58,59)
  61. 244   draw(54,51 to 56,51)
  62. 245   draw(54,52 to 56,52)
  63. 246   draw(51,53 to 59,53)
  64. 247   draw(51,55 to 52,55)
  65. 248   draw(58,53 to 59,53)
  66. 249   draw(58,55 to 59,55)
  67. 250   draw(54,56 to 56,56)
  68. 251   draw(54,57 to 56,57)
  69. 252   draw(54,58 to 56,58)
  70. 256   sshape(50,50;61,60),lg%
  71. 257   for x%= 0 to 22:lgs%(2,x%)=lg%(x%):next
  72. 300   rem diamonds
  73. 310   gosub 900:pena 4
  74. 320   draw(54,50 to 57,53 to 54,56 to 51,53 to 54,50)
  75. 321   pena 4:paint (54,55) ,1
  76. 326   sshape(50, 50;58,57),sm%
  77. 327   for x=0 to 18:sms%(3,x)= sm%(x):next
  78. 330   gosub 900:pena 4
  79. 331   draw(55,50 to 60,55 to 55,60 to 50,55 to 55,50)
  80. 332   paint(55,55),1
  81. 334   sshape(50,50;61,61),lg%
  82. 335   for x=0 to 22:lgs%(3,x)= lg%(x):next
  83. 400   rem spades
  84. 410   gosub 900:pena 1
  85. 420   draw(54,50)
  86. 421   draw(53,51 to 55,51)
  87. 422   draw(52,52 to 56,52)
  88. 423   draw(51,53 to 57,53)
  89. 424   draw(51,54 to 57,54)
  90. 425   draw(53,55 to 55,55)
  91. 426   draw(52,56 to 56,56)
  92. 427   sshape(50,50;58,57),sm%
  93. 428   for x=0 to 18:sms%(4,x)=sm%(x):next
  94. 430   gosub 900:pena 1
  95. 431   draw(55,50 to 60,55 to 60,56 to 59,57 to 51,57 to 50,56 to 50,55 to 55,50)
  96. 432   draw(54,58 to 56,58)
  97. 433   draw(52,59 to 58,59)
  98. 434   paint(55,55),1
  99. 436   sshape (50,50;61,60),lg%
  100. 437   for x=0 to 22:lgs%(4,x)=lg%(x):next
  101. 888   t=0
  102. 899   goto 1000
  103. 900   pena 2:box(25,25;100,100),1:pena 4:return
  104. 1000  rem ***** draw cards *****
  105. 1005  gosub 8000
  106. 1010  scnclr
  107. 1015  x=100:y=100
  108. 1020  gshape(x,y),card%
  109. 1025  graphic 1
  110. 1030  penb 2
  111. 1035  pena r
  112. 1039  rem *** aces ***
  113. 1040  ? at (x+2,y+9);"A"
  114. 1045  ? at (x+51,y+58);"A"
  115. 1050  gshape(x+1,y+11),sm%
  116. 1055  gshape(x+51,y+60),sm%
  117. 1065  gshape(x+25,y+32),lg%
  118. 1070  if t= 0 then dim card1%(570):sshape(100,100;161,171),card1%
  119. 1072  if t=1 then dim card14%(570):sshape(100,100;161,171),card14%
  120. 1073  if t=2 then dim card27%(570):sshape(100,100;161,171),card27%
  121. 1074  if t=3 then dim card40%(570):sshape(100,100;161,171),card40%
  122. 1080  gshape(x,y),card%
  123. 1085  pena r:?at(x+2,y+9);"2"
  124. 1086  ?at(x+51,y+58);"2"
  125. 1090  gshape(x+51,y+60),sm%
  126. 1095  gshape(x+25,y+10),lg%
  127. 1096  gshape(x+25,y+50),lg%
  128. 1110  if t=0 then dim card2%(570):sshape(100,100;161,171),card2%
  129. 1111  if t=1 then dim card15%(570):sshape(100,100;161,171),card15%
  130. 1112  if t=2 then dim card28%(570):sshape(100,100;161,171),card28%
  131. 1113  if t=3 then dim card41%(570):sshape(100,100;161,171),card41%
  132. 1120  rem three on two
  133. 1125  pena r:?at(x+2,y+9);"3"
  134. 1126  ?at(x+51,y+58);"3"
  135. 1135  gshape(x+25,y+31),lg%
  136. 1140  if t=0 then dim card3%(570):sshape(100,100;161,171),card3%
  137. 1141  if t=1 then dim card16%(570):sshape(100,100;161,171),card16%
  138. 1142  if t=2 then dim card29%(570):sshape(100,100;161,171),card29%
  139. 1143  if t=3 then dim card42%(570):sshape(100,100;161,171),card42%
  140. 1150  rem  four
  141. 1155  gosub 9020
  142. 1160  pena r:?at(x+2,y+9);"4"
  143. 1161  ?at(x+51,y+58);"4"
  144. 1165  gosub 9010
  145. 1170  gshape(x+15,y+10),lg%
  146. 1171  gshape(x+15,y+50),lg%
  147. 1175  gshape(x+35,y+10),lg%
  148. 1176  gshape(x+35,y+50),lg%
  149. 1185  if t=0 then dim card4%(570):sshape(100,100;161,171),card4%
  150. 1186  if t=1 then dim card17%(570):sshape(100,100;161,171),card17%
  151. 1187  if t=2 then dim card30%(570):sshape(100,100;161,171),card30%
  152. 1188  if t=3 then dim card43%(570):sshape(100,100;161,171),card43%
  153. 1195  rem five on four
  154. 1200  pena r:?at(x+2,y+9);"5"
  155. 1201  ?at(x+51,y+58);"5"
  156. 1210  gshape(x+25,y+30),lg%
  157. 1215  if t=0 then dim card5%(570):sshape(100,100;161,171),card5%
  158. 1216  if t=1 then dim card18%(570):sshape(100,100;161,171),card18%
  159. 1217  if t=2 then dim card31%(570):sshape(100,100;161,171),card31%
  160. 1218  if t=3 then dim card44%(570):sshape(100,100;161,171),card44%
  161. 1225  rem six on five
  162. 1230  pena r:?at(x+2,y+9);"6"
  163. 1231  ?at(x+51,y+58);"6"
  164. 1235  outline 0:pena 2:box(x+25,y+30;x+35,y+42),1
  165. 1240  outline 1
  166. 1245  gshape(x+15,y+30),lg%
  167. 1250  gshape(x+35,y+30),lg%
  168. 1255  if t=0 then dim card6%(570):sshape(100,100;161,171),card6%
  169. 1256  if t=1 then dim card19%(570):sshape(100,100;161,171),card19%
  170. 1257  if t=2 then dim card32%(570):sshape(100,100;161,171),card32%
  171. 1258  if t=3 then dim card45%(570):sshape(100,100;161,171),card45%
  172. 1265  rem seven on six
  173. 1270  pena r:?at(x+2,y+9);"7"
  174. 1271  ?at(x+51,y+58);"7"
  175. 1280  gshape(x+25,y+20),lg%
  176. 1285  if t=0 then dim card7%(570):sshape(100,100;161,171),card7%
  177. 1286  if t=1 then dim card20%(570):sshape(100,100;161,171),card20%
  178. 1287  if t=2 then dim card33%(570):sshape(100,100;161,171),card33%
  179. 1288  if t=3 then dim card46%(570):sshape(100,100;161,171),card46%
  180. 1295  rem eight
  181. 1300  gosub 9020
  182. 1305  pena r:?at(x+2,y+9);"8"
  183. 1306  ?at(x+51,y+58);"8"
  184. 1310  gosub 9010
  185. 1315  gshape(x+15,y+10),lg%
  186. 1316  gshape(x+15,y+50),lg%
  187. 1320  gshape(x+35,y+10),lg%
  188. 1321  gshape(x+35,y+50),lg%
  189. 1325  gshape(x+15,y+24),lg%
  190. 1326  gshape(x+15,y+38),lg%
  191. 1330  gshape(x+35,y+24),lg%
  192. 1331  gshape(x+35,y+38),lg%
  193. 1340  if t=0 then dim card8%(570):sshape(100,100;161,171),card8%
  194. 1341  if t=1 then dim card21%(570):sshape(100,100;161,171),card21%
  195. 1342  if t=2 then dim card34%(570):sshape(100,100;161,171),card34%
  196. 1343  if t=3 then dim card47%(570):sshape(100,100;161,171),card47%
  197. 1350  rem nine on eight
  198. 1355  pena r:?at(x+2,y+9);"9"
  199. 1356  ?at(x+51,y+58);"9"
  200. 1365  gshape(x+25,y+16),lg%
  201. 1370  if t=0 then dim card9%(570):sshape(100,100;161,171),card9%
  202. 1371  if t=1 then dim card22%(570):sshape(100,100;161,171),card22%
  203. 1372  if t=2 then dim card35%(570):sshape(100,100;161,171),card35%
  204. 1373  if t=3 then dim card48%(570):sshape(100,100;161,171),card48%
  205. 1380  rem ten on nine
  206. 1385  pena r:?at(x+1,y+9);"10"
  207. 1386  ?at(x+45,y+58);"10"
  208. 1395  if t=0 then dim card10%(570):sshape(100,100;161,171),card10%
  209. 1396  if t=1 then dim card23%(570):sshape(100,100;161,171),card23%
  210. 1397  if t=2 then dim card36%(570):sshape(100,100;161,171),card36%
  211. 1398  if t=3 then dim card49%(570):sshape(100,100;161,171),card49%
  212. 1400  '
  213. 1405  rem jack
  214. 1410  gosub 9020
  215. 1415  pena r:?at(x+1,y+9);"J"
  216. 1416  ?at(x+51,y+58);"J"
  217. 1420  gosub 9010
  218. 1425  pena 1:draw(x+10,y+60 to x+10,y+10 to x+50,y+10 to x+50,y+60 to x+10,y+60)
  219. 1426  gshape(x+14,y+14),lg%
  220. 1427  gshape(x+37,y+48),lg%
  221. 1435  if t=0 then dim card11%(570):sshape(100,100;161,171),card11%
  222. 1436  if t=1 then dim card24%(570):sshape(100,100;161,171),card24%
  223. 1437  if t=2 then dim card37%(570):sshape(100,100;161,171),card37%
  224. 1438  if t=3 then dim card50%(570):sshape(100,100;161,171),card50%
  225. 1445  rem queen
  226. 1450  pena r:?at(x+2,y+9);"Q"
  227. 1451  ?at(x+51,y+58);"Q"
  228. 1461  if t=0 then dim card12%(570):sshape(100,100;161,171),card12%
  229. 1462  if t=1 then dim card25%(570):sshape(100,100;161,171),card25%
  230. 1463  if t=2 then dim card38%(570):sshape(100,100;161,171),card38%
  231. 1464  if t=3 then dim card51%(570):sshape(100,100;161,171),card51%
  232. 1470  rem king
  233. 1475  pena r:?at(x+2,y+9);"K"
  234. 1476  ?at(x+51,y+58);"K"
  235. 1485  if t=0 then dim card13%(570):sshape(100,100;161,171),card13%
  236. 1486  if t=1 then dim card26%(570):sshape(100,100;161,171),card26%
  237. 1487  if t=2 then dim card39%(570):sshape(100,100;161,171),card39%
  238. 1488  if t=3 then dim card52%(570):sshape(100,100;161,171),card52%
  239. 1495  t=t+1
  240. 1496  if t>3 then 1498
  241. 1497  goto 1000
  242. 1498  chain "dice1",0,all
  243. 7000  rem
  244. 8000  rem
  245. 8001  if t=0 then 8010
  246. 8002  if t=1 then 8020
  247. 8003  if t=2 then 8030
  248. 8004  if t=3 then 8040 
  249. 8005  if t>3 then end
  250. 8010  for x=0 to 18:sm%(x)=sms%(1,x):next
  251. 8011  for x=0 to 22:lg%(x)=lgs%(1,x):next
  252. 8012  r=4:rem pen color
  253. 8015  goto 1010
  254. 8020  for x=0 to 18:sm%(x)=sms%(2,x):next
  255. 8021  for x=0 to 22:lg%(x)=lgs%(2,x):next
  256. 8022  r=1
  257. 8025  goto 1010
  258. 8030  for x=0 to 18:sm%(x)=sms%(3,X):next
  259. 8031  for x=0 to 22:lg%(x)=lgs%(3,x):next
  260. 8032  r=4
  261. 8035  goto 1010
  262. 8040  for x=0 to 18:sm%(x)=sms%(4,x):next
  263. 8041  for x=0 to 22:lg%(x)=lgs%(4,x):next
  264. 8042  r=1
  265. 8045  goto 1010
  266. 8500  for t= 1 to 2000:next:return
  267. 8999  stop
  268. 9000  rem *** routine for copy left top to right bottom
  269. 9001  for ac= a to b: rem across
  270. 9002  for dn= d to e: rem down
  271. 9003  n= pixel (x+ac,y+dn):pena n
  272. 9004  draw(x+60-ac,y+70-dn)
  273. 9005  next dn:next ac
  274. 9006  return
  275. 9010  gshape(x+1,y+11),sm%:gshape(x+51,y+60),sm%:return: rem small shape to top left
  276. 9020  rem ** print blank card **
  277. 9021  gshape(x,y),card%:return
  278. 9022  rem
  279. 9050  rem routine for number top to bottom only
  280. 9051  for a= 0 to 10
  281. 9052  for d= 0 to 10
  282. 9053  n= pixel (x+a,y+d):pena n
  283. 9054  draw(x+60-a,y+70-d)
  284. 9055  next d:next a
  285. 9056  return
  286. 9057  rem
  287.